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14-Sep-1984 FORRTL. FORERROR.B32; | (1) 
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{ 
0% 
; 1 0001 © MODULE FORSSERROR (XTITLE ‘Inzernal FORTRAN error handling modul | $s 4 
; ¢ o00¢ 8 IDENT = '1=022' ' File: FORERROR.632 He $BL1022 7 
; 4 0004 1 BEGIN 3; 4 
; 5 0005 1! 3 4 
. § poee SMBS SSCS TICS c irri Trt TTT TTI TTT IIIT IIT TTT TTT ITT Titi tititiiit 3 i 
; 1 Ie 5 
; 8 0008 1 !* COPYRIGHT (c) 1978, 1980, 1982, 1984 B 5 | 
: 9 0009 1 !* DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. « : 4 
; 19 Baty : :* ALL RIGHTS RESERVED. * F 4 
4 :* ® | Ps 4 
$ \§ Bolg 1 !* THIS SOFTWARE iS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * | : i 
79 00153 1 !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH hice SE AND WITH THE * ; i 
; 0014 1 !* INCLUSION OF THE ABOVE Typ t a NOTICE. THIS SOFTWARE OR ANY OTHER * | 
; % 0015 1 '* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * ; | 
: 16 0016 1 !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * : 3 
oe 0017 1 is TRANSFERRED. ‘ | ; i 
3 '® * - 4 
; 0019 1 !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * : i 
3 20 0020 1 !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * | oa 
; $ ita ' ‘* CORPORATION. * ad | 
° :* * j e 4 
i £ 0023 1 !* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILETY OF ITS’ * 3 i 
>; 626 0024 1 !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL * . 4 
; @ 0025 1 !«* * tj 
; @& 0026 1 !* * | 
: 27 QO27 1 eae eee eee RRR AEA A RETA A EAA AAA RERAKERARERRKERR EEE s §$ 
;: 0028 1! 3 7 
es ss, 0029 1 zg 7 
; 0030 1 !++ | 
: i 0031 1 ! FACILITY: FORTRAN support Library i | 
.. 0032 1! _ 
: 33 003 1 ! ABSTRACT: g- 4 
; 0034 1! | 3 i 
a ae 0035 1! This module contains the error handlers needed by a | 
ye 0036 1! the common OTS for handling FORTRAN errors. In dearticuler | 
; ov 0037 1! there is a handler for errors in OPEN/CLOSE where ERR= : ; 
; 0038 1! means error return to caller rather than a transfer. ; i 
; 0039 1! A second handler (FORSSERR_END_HND is provided i 
: 40 0040 1! for 1/0 statements where the optional ERR= and END= ot 
s 61 0041 1! constructs require a pranster of control to the : : 
; €2 0042 1! user program rather than an an error return. s 4 
3: «643 0043 1! A third handler, FORSSIOSTAT _HND is for auxilliary 1/0 statements if 
: «44 0044 1! which either undwind with RO containing an IOSTAT value or - ij 
3 65 0045 1! resignal. ij 
: rt boe$ : An argument specifies the cleanup to be performed if UNWIND occurs. : 4 
:; «648 0048 1 ! ENVIRONMENT: User mode, AST Level or not or mixed. : ( 
:; «649 0049 1! Note: this module is both shared (with no entry vectors) and non-shared | - ij 
: 20 Bpeo : if FORTRAN compatibility routines call. | 
; 2g Og : ; AUTHOR: Thomas N. Hastings, CREATION DATE: 03-Jun-77 : 
; 7 0054 1 ! MODIFIED BY: : , 
ee 0055 1: > 
; 0056 1! Thomas N. Hastings, 03-Jun-77: VERSION 01 ord 
; oT 0057 1! Steven B. Lionel, VAX/VMS V2.0 3 
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PROLOGUE FILE: 


pejojleleleo) 
SNAAAO 
OOONO 


REQUIRE "RTLIN:FORPROLOG'; 


FORTRAN definitions 
1 


TABLE OF CONTENTS: 


FORWARD ROUTINE | 
FO ror handler for OPEN/CLOSE 


¥ | &r 
FORSSERR_ENDHND, ' ERR=/END= handler for I/0 statements 
FORSSIOSTAT_HND, ' IOSTAT only handler 
FORS$$10_IN_PROG ! 1/0 in progress handler 
CLEANUP~LUB : NOVALUE; Perform appropriate LUB cleanup if UNWIND. 


signal List. 


ee a a a a ee a Oe 


EQUATED SYMBOLS: 
NONE 

OWN STORAGE: | 
NONE 

EXTERNAL REFERENCES: 


+ 


MAINTENANCE NOTE: Since this module is called by FORTRAN compatibility 

routines which are unshared and the entry points are not vectored, 

a@ separate copy of this module is Linked with the user program when 

the user calls a FORTRAN compatibility routine. In order to prevent 

data truncation errors from the Linker, all external references are 

? aderess ing sede general (rather than word displacement) even for 
e same . 


SOONAUE WIN ( O ODNOAOU EWN O OONOULS WN ODOONO 


EXTERNAL ROUTINE 
FORSSCB_GET : JSB_CB_GET NOVALUE, ! Get current LUB/1SB/RAB . | 
! Note: this non-shared routine is loaded if 
' com +g RY routines call, so can't reference 
' FORSSA_CUR_LUB directly. 
' Pop current LUB/ISB/R 
! as spec itied by CcB, 
' Match FP in ISB chain 
' Free virtual memory 
' RMS Close a file 
! SIGNAL_STOP OTSS_FATINTERR 
! SIGNAL_STOP OTS$_ INTDATCOR 
' (FATAL INTERNAL ERROR IN RUN-TIME LIBRARY) 
! convert a SIGNAL to error return . 
! to caller of establisher with RO set to signal value. 


FORS$CB_POP : JSB_CB_POP NOVALUE, 

FORSSFP MATCH : CALL_CCB NOVALUE, 
FILE, 

FORS$SIG_FATINT : NOVALUE, 

FORS$SIG-DATCOR : NOVALUE, 

LIBS$SIG_TO_RET; 
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Internal FORTRAN error handling module bese -1984 20:31 AX-11 Bliss-32 V4.0-74 Page 4 
° 12-808-1 ope 90:99 :3) FORRTL.SRCIFORERROR .B3 31 ° (3) | 
GLOBAL ROUTINE FORSSERR_OPECLO ( ' Error condition handler for OPEN/CLOSE | 
SIG_A Adr. of SIGNAL args 


ENB-ARGS_ADRS Adr. of ENABLE declared args 


i 
MCH-ARGS_ADR, | Adr. of mechanism args 
i Condition handlers always have values 
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FUNCTIONAL DESCRIPTION: 


FORSSERR_OPECLO is an error conditon handler established by 

the OPEN and CLOSE statement procedures. If the user specified 

an ERR= keyword parameter, the handler unwinds the stac otter 

oh he the signaled error condition in the saved image of RO. 

Otherwise, FORSSERR_ OPECLO just resignals by simply returning 

SS$_RESIGNAL (to CHF). 
If and when an UNWIND occurs, the ENABLE arg UNWIND_ACT_ADR 
specifies whether the LUB/ISB/RAB is to be por. returned, or no-opped. 
It is not Ve if it had not ret been pushed as indicated 
by the ENABLE arg UNWIND_ACT_ADR. 


If ERR= and IOSTAT were both specified, then the returned 
value is the FORTRAN small integer error code. 


' FORMAL PARAMETERS: 
SIG-ARG-ADR 
SIG_ARGS_ADR.rl.ra Adr. of Signal arg List 
MCH_ARGS_ADR.rl.ra Adr. of mechanism arg List 
ENB_ARGS_ADR.rl.ra Adr. of ENABLE arg List which contains: | 
ENABCE_COUNT.rbu.v No. of longword following in ENABLE arg list 
UNWIND _ACT_ADR.rl.r Adr. of lLongword containing UNWIND action code. | 
ony of FORSK_UNWINDNOP, FORSK_UNWINDPOP, 
FORSK_UNWINDRET. 


phy oy. after the encoded user parameter 
ist has been scanned and expanded into it. 

Symbolic offsets into ENB_ARGS_ADRC1,OPENSK_name] are of the 
form OPENSK_name as defined in FOROPN REQUIRE file. 
If ommitted, assume no ERR= (DEFINE FILE, REWIND, etc) 


WO DONO UWE WN 0 OODNAVNEWN SO OODNAUE WN" OODNOUSW 


IMPLICIT INPUTS: 


FORSS$A_CUR_LUB Adr. of current LUB/ISB/RAB or 0 
Note: obtained by cot ine FORSS$CB_GET 
rather than directly. 
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IMPLICIT OUTPUTS: 
SIG_ARGS_ADRCSIG$_USER_PC) Set to user call PC to RTL 
' COMPLETION CODES: 


$55 RE SIGNAL if no ERR= was specified 
SSS_NORMAL if 


SIDE EFFECTS: 


ERR= was specified (ignored by CHF on UNWIND) 
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FORSSERROR Internal FORTRAN error handling module bese -1984 00:20:31 AX-11 Bliss-32 V4.0-74 Page 5. 

1-022 . 12-80-1382 99:99 :8) FORRTL. SRCIFORERROR.B3 ¥ “ (3) 

; 180 43 1! If the user has specified ERR=, the stack is unwound to the ; 
; «(181 44 1! caller of the establisher (i.e., the user program) with the save image H 
3 \8¢ 45 1! of RO set to the error status. : 
; ‘3 , } If no ERR= was specified,the error conditon is resignaled. : 
> «(184 8 47 1! If UNWIND call, the current LUB/ISB/RAB may be popped or returned. : 
: Be a a 
; 187 0 30 BEGIN ; 
> 189 0256 BUILTIN : 
; 190 025 CALLG, 5 
: 133 0588 
; 198 0 2$ LITERAL ! Define ENABLE arglist offsets | ; 
> 6194 025 ENABLE_COUNT = 0, ! Offset in ENB_ARGS_ADR of no. of enable args following ; 
> «195 0258 UNWIND_ACT_ADR = 1, ' Adr. of longword containing : 
> 196 0259 : UNWIND action code. ‘ : 
3 44 O50) OPECLO_ADR = 2; ! Adr. of OPEN/CLOSE cannonical array : 
: 199 026¢ MAP | 
; 200 026 SIG_LARGS_ADR : REF BLOCK C, BYTE], ' SIGNAL args : 
: 201 0264 é MCH-ARGS_ADR : REF BLOCK C, BYTE), i mechanism args : 
: $06 BS02 § ENB-ARGS_ADR : REF VECTOR COPECLO_ADR, LONG]; ‘ENABLE args List array | : 
: 204 0267 LOCAL | ; 
; 205 0268 EST_FP : REF BLOCK C, BYTE], ! Establisher's FP ‘ 
> 206 0269 SIG-PC_LOC: REF VECTOR [ LONG] i Location of user PC in signal List ; 
; 207 pete 2 OPETLOTARRAY : REF VECTOR OPENSK_KEY_MAX + 1, LONG]; ! OPEN/CLOSE cannonical array : 
: 509 a 
; 210 027 § ! If this is unwind condition, pertorm cleanup. since ; 
3 (ett 0274 ! Perform LUB cleanup indicated by EBABLE arg UNWIND_ACT_ADR : 
: 22 0275 2 ' (set by the establisher). : 
Oped iB Ree ee 
> 215 $598 IF_.BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAME], STSS$SV_COND_ID;, BYTE] EQL (SS$_UNWIND*-3) : 
; 24 0279 THEN : 
s a 0280 BEGIN : 
; 218 0281 CLEANUP_LUB (..ENB_ARGS_ADR CUNWIND_ACT_ADR]); ‘ 
; 219 pee RETURN SS$_NORMAL; ° 
; 281 bso? END; : 
> ee 0585 OPECLO_ARRAY = .ENB_ARGS_ADR COPECLO_ADR); | : 
Bo RBG : 
3; ¢¢3 288 ! If this is not a FORS error or if another RTL handler has seen this : 
; 226 289 ! error (noted by signal argument for user PC being non-zero) then : 
: 7 90 ! just resignal. ; 
; 25 4 te : 
; $0 $8 Vv OL Oe CSIG_ARGS_ADR CCHFSL_SIG_NAME], STS$V_FAC_NO;, BYTE] NEQ FORSK_FAC_NO : 
; 99 RETURN SS$_RESIGNAL; : 
: 34 39 SIG_PC_LOC = 316 ARGS_ADR CCHFSL_SIG_ARG1] + (.SIG_ARGS_ADR CCHFS$L_SIG_ARG1] * ZUPVAL); : 
: 935 0298 IF; S1_PC_Lot 0] NEG 0 : 
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Internal FORTRAN error handling module 16-Sep-1984 AX=-11 Bliss -32 V4.0-7 Pa FOR 
. la-Sep- 382 99: @9 3] FORRTL SRC IFORERROR. B3 31 ” (35 1-0 
3 6 RETURN SS$_RESIGNAL; 
14 

4 0 ' Check if user provided ERR= keyword gr not. If yes convert signal to 
4 0 ' a return to the caller of the establ iy’ with condition value in RO. 
4 0 ! If IOSTAT is present, act as if E is 
: 8 If caller omitted OPECLO_ ADR entry in ENB tARGS ADR, treat as if no ERR=. 
4 0 
4 0 
4 


IF .ENBLARGS ADR CENABLE COUNT] GEQU OPECLO_ADR AND (.OPECLO_ARRAY COPENSK_ERR] OR .OPECLO_ARRAY 
THEN “OPENSK_IOSTAT]) REQ 0 ve , 


BEGIN 
¢ 
If IOSTAT was specified, store the value. 


Re rps teenie COPENSK_IOSTAT] NEQ 0 
BEGIN 


LOCAL 
IOSTAT; 


IOSTAT = .BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAMEJ, STS$SV_CODE;, BYTE); 
IF _,OPECLO_ARRAY COPENSK_IOSTAT_LJ 
Lge OPECLOAARRAY COPENSK IOSTATI = .1OSTAT 

BEGIN 


LOCAL 
IOSTAT_ADR : REF BLOCK C, BYTE]; 


IOSTAT_ADR = .OPECLO_ARRAY a (titi IOSTATI; 
postal ADR C0; 0, 16, 0] = 


7? 
8 
9 
0 
1 
§ 
4 
5 
6 
7? 
8 
9 
0 
1 
g 
4 
5 
6 
7 
8 
9 
0 
3) 
68 


END; 
IF NOT CALLG (.AP, LIBSSIG_TO_RET) THEN FORSSSIG_FATINT () 
END 


PALO COON NEW $0 OONAUE UN (OO DNAUE WIN S(O OONAUS ARO OONOUS WO 
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ELSE 
4 a 
' : No ERR=, so set user call PC saved in stack frame of establisher and RESIGNAL 
: ‘ 
5 BEGIN 
5 EST_FP = .MCH_ARGS_ADR CCHFSL_MCH FRAM i; 
; SIG-PC_LOC COJ = .EST_FP CSFSC_SAVE_PCJ; 
: END; ' End no ERR= 


; | 
FORSSERROR Internal FORTRAN error handlin dul 1 “19 :20:31 AX-11 - 4. FOR! 
Fors g module 5 “Sep S 00:49: 3) Bliss-32 V4.0-7 Page 7 ' 


2 14-Sep-1984 FORRTL.SRCJFORERROR. ba 31 (3) -0; 
: 296 0 57 '+ 
3 Be 8 28 Return resignal condition (ignored if SYSSUNWIND called). 
; 29 0360 
: 298 0361 RETURN SS$_RESIGNAL 
: 299 0362 1 END; ! End of FORSSERR_OPECLO handler 
-TITLE FORSSERROR Internal FORTRAN error handling modu 
.IDENT \1-022\ 
.EXTRN FORSSCB_ GET, FORS$CB_POP 
SEXTRN FORSSFP-MATCH, FORSSFREE_VM | 
EXTRN FORSSCLOSE FILE 
EXTRN FORSSS16 _FATINT 
SEXTRN FOR HS DATCOR | 
-EXTRN LIBS$SIG_TO_RET ef 
.PSECT _FORSCODE,NOWRT, SHR, PIC.2 | 
000¢ 00000 .ENTRY FORSSERR -OPECLO Save R2,R3 : 0186) i 
52 04 AC DO 00002 MOVL et RgS Re : 0278) 
00000124 28F 04 A2 19 03 ED 90006 CMPZV #2 “ARS. #292 : 
10 iF 9001 BNEQ : | 
50 0c aC DO 00012 MOVL Ne ARGS_ADR, RO : 0281) 
04 BO DD 00016 PUSHL ; 
0000v CF 01 FB 00019 CALLS #1, CLEANUP_LUB : 
50 01 DO O001E MOVL #1, RO : 0282. 
04 9021 RET : 
53 Oc ac 00 900 2 1$: MOVL ENB ARGS_ADR, R3 ; 0285 
50 08 a3 00 00026 MOVL (R3), OPECLO_ARRAY : 
18 06 A2 0c 00 ED 0002A CMPZ2V #0, #12, 6(R23, #24 : 0293 
54 12 00 0 BNEQ 5$ : 
51 08 A2 00 00032 MOVL 8(R 3) ; 0297 | 
51 08 A241 DE 00036 MOVAL 8(R tre] $1G_PC_LOC : | 
61 D5 00038 TSTL (SIG_PC_L : 0298 | 
47 12 90030 BNEQ = 5$ ; | 
02 63 01 0003F CMPL (R3), #2 : 0309. 
36 1F 00042 BLSSU 4$ ; 
53 Oc ad 58 =A0 £9 0044 BISL3 88(OPECLO_ARRAY), 12(OPECLO_ARRAY), R3 : 
2—E 13 OOO4A BEQL 86 4$ > 0310) 
53 58 A 00 004¢ MOVL oe ARRAY), R3 ; 0318 | 
52 06 A2 0c §3 EF 0082 EXT2V #12, 4(R2), IOSTAT > 0325 | 
05 64 Ad £9 000 BLBC TOOCOPECLO ARRAY), 2$ : 03 7 | 
63 52 D0 O99¢ MOVL OSTAT, (R3) ; 0329 | 
06 11 0005F BRB ; 
50 09 0061 28 MOVL aS ; 0 36 
60 52 8B 0064 MOVW Osta T, STATOSTAT ADR) : 0337 | 
000000006 00 6¢ FA 00067 3$ CALLG (AP), LIBSSIG_TO_RET > 0342. 
15 E8 O06 BLBS RO, s° ; | 
000000006 00 90 re a0¢8 CALLS #9, FORSSSIG_FATINT 
50 08 aC D TA 4$ MOVL | MCH_ARGS_ADR, RO : 0352 
0 04 AO D oor MOVL 4 (RO), EST FP ; 
61 10 Ad 00 0008 MOVL  16(EST_FP)> (SIG_PC_LOC) : 0353 
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F 
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0918 8F 3 pons 5$: 


_FORSCODE + 0000 
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Internal FORTRAN error handling module 1b-se -1984 20:31 AX-11 Bliss-32 V4.0-7 
. 12-8 08- 1 3b2 99:99 32) 


GLOBAL ROUTINE FORSSERR_ENDHND ( ! FORTRAN I/O statement ERR=/END= error condition handler 
SIG_ARGS_ADR, ! Adr. of signal arg List 
MCH_ARGS_ADR ! Adr. of mechanism arg List 
ENB-ARGS_ADRS i Adr. of ENABLE arg List 
= ! Return status for a condition handler 


144 


i FUNCTIONAL DESCRIPTION: 


FORSSERR_ENDHND is an error condition handler established 
by each I/O statement which has an ERR= and END= error transfer 
mechanism (as an option of the user program). | 


If the signaled condition is FORS_ENDDURREA (24=°END-OF FILE DURING READ‘) 
and an END= has been specified by the user in his 1/0 statement 

(.END EQL_ADR NEQ 0), the handler unwinds to the user specified address (by calling 
SYSSUNWIND with depth equal to CHFSL_MCH DEPTH + ..INCR_DEPTHADR + 1) 

and new_PC egual to ..END_EQIL ADR. 

Gthery ines if an ERR= had been specified by the user in his I/0 statement 

(ERR_EQUL NEQ 0), the handler unwinds to the user specified address 

by yo SYSSUNWIND with depth equal to CHFSL_MCH_DEPTH + ..INCR_DEPTH_ADR + 1 
and new_PC equal to ..ERR_EQL_ADR. 


If neither of the above cases holds, the error is resignaled 
so that a user handler or the OTS default handler will get invoked. 
If UNWIND occurs, the appropriate cleanup takes place 
as indicated 7 the establisher in the ENABLE arg UNWIND_ACT_ADR. 
If FORSK_UNWINDPOP is indicated, the current LUB/ISB/RAB is popped. 
| age pl peat is indicated, the LUB/ISB/RAB is returned and the 

e closed. 
Otherwise (FORSK_UNWINDNOP) nothing is done. 

| 


FORMAL PARAMETERS: 


SIG_ARGS_ADR.ml.ra Adr. of signal arg List 
MCH_ARGS_ADR.ml.ra Adr. of mechanism arg List. 7 
ENB_ARGS_ADR.ml.ra Adr. of ENABLE arg List which contains: 
UNWIRD_ACT_ADR.rl.r Adr. of longword contining UNWIND action code. 

Any of FORSK UNWINDNOP, FORSK_UNWINDPOP, 

FORSK_UNWINDRET. 
ERR_EQL_ADR.ra.r Adr. of songuers containing Adr. of the user address 
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to be transferred to or 0 on any error condition 
END_EQL_ADR.ra.r Adr of longword containing Adr. of the user address 
to be transferred to or 0 on end-of-file é | 
INCR_DEPTH_ADR.rl.r Adr. of longword containing Incremental no. of frames between the establishe | 
and the users progres (usually Oor 1). | 
Note: ALL parameters to a condition handler must be addresses of values in BLISS if used in am ENABLE. 


IMPLICIT INPUTS: 


FORS$A_CUR_LUB Adr. of current LUB/ISB/RAB or 0 . 
Note: obtained by calling FORSSCB_GET rather than directly. 
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IMPLICIT OUTPUTS: 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
: 
: SIG_ARGS_ADRC(SIG$_USER_PCJ Set to user call PC to RTL 
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; 28 on 1 } } COMPLETION CODES: 
; 361 4 ; i SSS_RESIGNAL if no ERR= or END= was specified by user, so that 
; o¢ 0424 1! a user handler or the default OTS handler will get a chance. 
; 7 Be 5 : } SSS_NORMAL if unwind called (although ignored if unwind called) 
: 365 4 4 1 ! SIDE EFFECTS: 
: 366 428 1! 
$ 7er 429 1! If END= and EOF OR ERR= was specified, the stack is unwound 
; 368 0450 1! to user and new_PC is set from . -END_EQL_ADR or .ERR_EQL_ADR. 
: a4 7 1 ' If unwind, the current LUB/ISB/RAB may be popped or returned. 
; 371 04 ¢ 1 
: Lf 0434 BEGIN 
5 a7 0435 
: 374 0436 LOCAL 
; 20 0437 2 EST_FP : REF BLOCK C, BYTE], ! Establisher's FP 
3 3/8 et 2 SIG-PC_LOC: REF VECTOR C, LONG); ' Location of user PC in signal List 
° | 
; 378 0440 5 LITERAL ! Declare offsets in ENABLE VECTOR arg List 
, oT 0441 2 UNWIND_ACT_ADR = 1, ! UNWIND action code 
: 380 044 2 ERR_EQC_ADR = 2, ! ERR= adr or 
; «381 0443 2 END EQL_ADR = 3, ! END= adr or 0 
; 382 0444 § INCR_DEPTH_ADR = 4; ! incremental depth 
; 383 0445 5 
> 384 0446 2 MAP F 
s 359 0447 § SIG_ARGS_ADR : REF BLOCK f- BYTE}. ' SIGNAL arg List : 
; 386 0448 MCH_ARGS_ADR : REF BLOCK YTEJ, ! mechanism arg List ; : 
; 387 0449 2 ENB_ARGS_ADR : REF VECTOR EINCR_DEPTH_ADR + 1, LONG]; ! ENABLE arg List 3 
; 388 0450 2 : 
; 389 0451 2 3 
; 390 Bees 2 '¢ : 
; oy 0455 2 ! Check for unwinding since handler gets called when it does an unwind. 
: 392 0454 2 ! If unwind, perform cleanup indicated by ENABLE arg UNWIND_ACT ADR. 
3 $07 Bee2 § Then return to the unwinder to keep unwinding (return value ignored). 
: 395 0457 
; 396 0458 : IF .BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAME], STSSV_COND_ID;, BYTE] EQL (SS$_UNWIND*-3) 
oar 0459 THEN 
; 398 0460 BEGIN 
; 399 0461 CLEANUP_LUB (..ENB_ARGS_ADR CUNWIND_ACT_ADR]); 
; 400 0468 3 RETURN SS$_NORMAL; 
; 401 0463 2 3 
; 40 0464 
; 40 0465 + | 
: 404 0466 ' If error is not a FORS$ error or if another RTL handler has seen 
; 405 0467 ! this error then resignal. 
RG 
3 rs Be58 IF .BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAME], STSSV_FAC_NO;, BYTE] NEQ FORSK_FAC_NO 
; eit bee RETURN SS$_RESIGNAL; 
3 oi¢ 0474 SIG_PC_LOC = $16 ARGS_ADR CCHFSL_SIG_ARG1] + (.SIG_ARGS_ADR CCHFSL_SIG_ARG1] * ZUPVAL); 
3; (41 475 IF 7SIG_PC_LOC CO] NEG 0 
: 416 476 THEN 
3; 6415 0477 RETURN SS$_RESIGNAL; 
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41 047 
a19 ne: + 
418 bree ' Check for END= and re 
419 481 ! If this is end-of-file (during read) 
420 pres ! Unwind to the user with the new_pc being .END_ADR and with 
421 04 ' RO as an IOSTAT value of -1. 
158 ouBs 
: ¢ Bree een CEND_EQL_ADR] NEQA 0 AND .SIG_ARGS_ADR CCHFSL_SIG_NAME] EQL FORS_ENDDURREA 
re 0488 BEGIN 
rt rh 34 
428 490 LOCAL 
$62 0491 Tg 
430 984 
431 049 MCH_ARGS_ADR yintg: MCH_SAVRO) = <1; 
432 049% T =". MCH_ARGS_ADR CCHFSC_MCH_DEPTH] + ..ENB_ARGS_ADR CINCR_DEPTH_ADR] + 1; 
434 0496 IF SUNWIND (DEPADR = T, NEWPC = ..ENB_ARGS_ADR CEND_EQL_ADR]) 
435 0497 THEN 
436 0498 RETURN SS$_NORMAL 
437 0499 ELSE 
2 0500 FORSSSIG_FATINT () 


END; 
'+ 
: If this is an error, and ERR= was got bby by the user, 
! Unwind to the user with the new-pc being .ERR_ADR and 
with RO set to the proper IOSTAT value. 
IF ..ENB_ARGS_ADR CERR_EQL_ADR] NEQA 0 
THEN 

BEGIN 


LOCAL 
T: 


IF _<SIG_ARGS_ADR CCHFSL_SIG_NAME] EQL FORS_ENDDURREA 
MCH_ARGS_ADR CCHFSL_MCH_SAVRO) = -1 
MCH_ARGS_ADR CCHFSL_MCH_SAVRO] = .BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAME], STS$V_CODE;, BYTE); 
T = .MCH_ARGS_ADR CCHFSL_MCH_DEPTH] + ..ENB_ARGS_ADR CINCR_DEPTH_ADR] + 1; 
IF _SUNWIND (DEPADR = T, NEWPC = ..ENB_ARGS_ADR CERR_EQL_ADR]) 
RETURN SS$_NORMAL 
FORSS$SIG_FATINT () 
END; 


+ 
! If neither END= nor ERR= specified by user. 


POPININIWNIWIWIAE BANNAN ANID POP NONINPIPONPIPINI WANN BWW 


WANA NIIP IPIPINOPYNINININIDD 2 9 OO OO SK OOOOOOCOCOCO 
PUN (OOO NOAUES WN" O OONOAUE WN ("OO ONOU ES Wh 


a 
FORSSERROR Internal FORTRAN error handling module 16-Sep-1984 00:20:31 AX-11 Bliss-32 V4.0-74 
1-022 ° 1a-Sep-19 4 90:99 :2) FORRTL. SRC IF ORERROR.B3 31 


; 473 535 ' Scan back from frame of establisher to frame of routine to called by user. 
> 474 5 $ ' Set user CALL PC to L erary n SIGNAL arg List. 
> 475 5 ! Just indicate to the condition handling facility to resignal the condition 
; ots B 3 ; SO that a user supplied handler or the OTS default handler will get a chance to handle. 
: 478 0540 
; $2 0343 EST_FP = .MCH_ARGS_ADR CCHFSL_MCH_FRAME]; 
: 481 054 DECR I FROM ..ENB_ARGS_ADR CINCR_DEPTH_ADR] TO 1 DO 
: 48 0366 EST_FP = .EST-FP Esse. SAVE FPI. “s 
: 484 0546 SIG_PC_LOC CO) = .EST_FP CSF$L_SAVE_PC); 
> 485 0547 . . = e 
: 486 0548 RETURN SS$_RESIGNAL 
: 487 0549 1 END; 'End of FORSSERR_ENDHND 
-EXTRN SYSSUNWIND 
007¢ 00000 .ENTRY FORSSERR_ENDHND, Save R2,R3,R4,R5,R6 
56 000000006 00 9€ 00002 MOVAB FORSSSIG-FATINT. R6 
55 000000006 00 H 00009 MOVAB SYSSUNWIRD, RS 
5E 08 C 90019 SUBL2 #8, SP 
52 04 AC DO 0001 MOVL §$IG_ARGS_ADR, R2 
53 04 Ad 9E 00017 MOVAB 4(R2), R 
00000124 8F 63 19 03 ED 0001B CMPZV #3, #25, (R3), #292 
OF 12 00024 BNEQ 1 
50 Oc AC DO 00026 MOVL § ENB_ARGS_ADR, RO 
04 BO DD OO002A PUSHL  @4(RO) 
0000v CF 01 FB 00020 CALLS #1, CLEANUP_LUB 
0080 31 00032 BRW 7$ 
18 02. A3 0c 00 ED 00035 1$ CMPZV #0, #12, 2(R3), #24 
0B 12 00038 BNEQ 23 
50 08 A2 D0 0003p MOVL (R2), RO 
54 08 A240 DE 00041 MOVAL 8(R2)ERO], $IG_PC_LOC 
64 05 00046 TSTL ($1G_PC_LOC) 
03 13 00048 2$ BEQL «=ss3$ 
0089 31 O004A BRW 12$ 
52 OC AC DO 00040 38 MOVL § ENB_ARGS_ADR, R2 
0C B2 D5 00051 TSTL at2tR2) 
A 13 00054 BEQL 4$ 
001880C4 BF 63 D1 00056 CMPL (R3), #1605828 
21 iF 9009 BNEQ 
50 08 AC 00 0005F MOVL § MCH_ARGS_ADR, RO 
oc Ao 01 CE 00063 MNEGL #1 1e(RO) 
50 08 a0 10 B2 C1 00067 ADDL3 a@14(R2), 8(RO), RO 
&E 01 AO 9E 0006D MOVAB 1 f 
OC B2 OD 00071 PUSHL  a@12(R2) 
04 AE 9F 00074 PUSHAB 
65 Q FB 0077 CALLS #2, SYSSUNWIND 
38 E8 OO007A BLBS RO, 7$ 
65 00 FB 0007D CALLS #9 FORSSSIG_FATINT 
08 g D 008 4$: TSTL a8(R2) 
1 0 BEQL 
50 08 aC dd 0008 MOVL  MCH_ARGS_ADR, RO 
001880C4 8F 63 D1 00089 CMPL (R3T, #1605828 
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; 490 939) 1 GLOBAL ROUTINE FORSSIOSTAT_HND ( ! FORTRAN I/0 IOSTAT handler ; 
; 491 5 § 1 SIG_ARGS_ADR, ! Adr. of signal arg List ‘ 
; 49 0555 1 MCH_ARGS_ADR ! Adr. of mechanism arg list ‘ 
: 49 0554 1 ENB-ARGS_ADRS i Adr. of ENABLE arg List | : 
> 494 0555 1 = ! Return status for a condition handler : 
> 495 b2e9 1 : 
; 496 0557 1 !++ : 
; 497 0558 1 ! FUNCTIONAL DESCRIPTION: : 
; 498 0559 1! ‘ 
> 499 0560 1! FORSSIOSTAT_HND is an error condition handler established by each | ‘ 
: 500 0561 1! eat /O_statement which can have as optional arguments ‘ 
; 203 §26¢ } } ERR= and IOSTAT=. : 
; : ‘ 
; $03 0564 1! If the enable argument ERR_EQL_ADR is non zero, FORSSIOSTAT_HND ; 
; 504 0565 1! unwinds with the saved RO Set fo the appropriate IOSTAT smaTl : 
; 305 0566 1! integer FORTRAN error number. If ERR_EQL_ADR is zero, then it : 
: 506 0567 1! is assumed that no ERR= is present and the error is resignalled. ‘ 
; 507 0568 1! Note that the unwind is not done to the ERR= address, rather the ; 
; 508 0569 1! compiled code makes a test of the returned value and branches | ‘ 
; 298 B20 : to the designated ERR= statement itself. | : 
; 31 B2r¢ 1 If UNWIND occurs, the appropriate ctpenye takes place : 
; 512 0573 1 | as indicated by the establisher in the ENABLE arg UNWIND_ACT_ADR. | : 
3; Di? 0574 1! If FORSK_UNWINDPOP is indicated, the current LUB/ISB/RAB is popped. : 
s 314 0575 1! If FORSK_UNWINDRET is indicated, the LUB/ISB/RAB is returned and the ; 
: 515 0576 1! file closed. ‘ 
; 218 bere : Otherwise (FORSK_UNWINDNOP) nothing is done. : 
: 518 0579 1 | FORMAL PARAMETERS: | : 
; 319 0580 1! : 
s 320 0581 1! SIG_ARGS_ADR.ml.ra Adr. of signal arg List : 
; 521 p26 ' 7 MCH_ARGS_ADR.ml.ra Adr. of mechanism arg List. . ; 
; 256 woes 3 ENB_ARGS_ADR.ml.ra Adr. of ENABLE arg List which contains: : 
; te 0584 1! UNWIND_ACT_ADR.rl.r Adr. of Longword cont ining UNWIND action code. : 
> 524 0585 1 | Any of FORSK_UNWINDNOP, FORSK_UNWINDPOP, : 
3 See 0586 1! FORSK_UNWINDRET. : 
5° 5e6 0587 1! ERR_EQL_ADR.rl.v 0 if there is no ERR= on the statement : 
s Ser 0588 #1! if there is an ERR= present. ; ; 
3 338 £334 : Note: ALL parameters to a condition handler must be addresses of values in BLISS if used in an ENABLE. : 
Py . | e 
; 530 0591 1°! IMPLICIT INPUTS: : 
3 30) B26 1! : 
3; jn 0595 1! FORS$A_CUR_LUB Adr. of current LUB/ISB/RAB or 0 : : 
; 237 8238 ! Note: obtained by calling FORSS$CB_GET rather than directly. : 
3 «399 0596 1 ! IMPLICIT OUTPUTS: : 
; 536 0597 1! : 
; 230 Fa ' MCH_ARGS_ADR CCHFSL_MCH_SAVRO] Set to an IOSTAT value ‘ 
; So 0600 1 ! COMPLETION CODES: : 
; 540 0601 1! ; oe : 
3: «541 0602 1! SS$_RESIGNAL if no ERR= or END= was specified by user, so that 3 
: 266 0605 1! a_user handler or the default OTS handler will get a chance. ; 
3 i see : SS$_NORMAL if unwind called (although ignored if unwind called) : 
: 2 Z 0606 : | SIDE EFFECTS: : 
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BEGIN 
MCH_ARGS_ADR CCHFSL_MCH_SAVRO) = .BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAME], STSS$V_CODE;, BYTE): 
IF SUNWIND () 


; 547 0608 1! If ERR= was specified, the stack is unwound to the user. : 
> 548 bet6 1! If unwind, the current LUB/ISB/RAB may be popped or returned. ; 
5 247 610 1 !-- ‘ 
> 550 0611 1 : 
> 55] bel¢ BEGIN : 
; 226 061 : 
; 2 0614 LOCAL ; 
> 554 0615 EST_FP : REF BLOCK C, BYTE) ! Establisher's FP | ; 
; 22? $918 SIG-PC_LOC: REF VECTOR C, LONG); ! Location of user PC in signal List | : 
: 557 0618 LITERAL ' Declare offsets in ENABLE VECTOR arg List F 
; 558 0619 UNWIND_ACT_ADR = 1, ! UNWIND action code | : 
; 559 0620 ERR_EQC_ADR = 2; ! ERR= present, 1 or 0 ; 
; 560 0621 3 
> 561 +e) MAP ; 
; 062 § SIG_ARGS_ADR : REF BLOCK f. BYTE), ! SIGNAL arg List | : 
; 0624 MCH_ARGS_ADR : REF BLOCK BYTE), ! mechanism arg List | : 
; 0625 é ENB-ARGS_ADR : REF VECTOR CERR_EQL_ADR + 1, LONG]; ! ENABLE arg List F 
0699 2 ' | : 
; '¢ : 
: 0628 2 : Check for unwinding since handler gets called when it does an unwind. ; 
: 0629 2 ! If unwind, perform cleanup indicated by ENABLE arg UNWIND_ACT_ADR. ; 
; 569 Be50 § Then return to the unwinder to keep unwinding (return value ignored). | : 
: 57 063 ; 
; 0638 : IF .BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAME], STSS$V_COND_ID;, BYTE] EQL (SS$_UNWIND*-3) | : 
3 Of 0634 $ THEN : 
; 574 0635 BEGIN 3 
; 575 0636 3 CLEANUP_LUB (..ENB_ARGS_ADR CUNWIND_ACT_ADR)); : 
; 37 0637 3 RETURN SS$_NORMAL; | : 
3. Ove 0638 2 END; 

; 578 0639 2 

; oP 0640 2 '¢ 

; 580 0641 2 ! If this is not a FORS$ error or if another RTL handler has seen this 

> 581 0642 2 ! error (noted by signal argument for user PC being non-zero) then 

; 582 0643 2 ! just resignal. 

s 2D 0644 2 te 

> 584 0645 2 | 

; 585 0646 2 IF .BLOCK CSIG_ARGS_ADR CCHFS$L_SIG_NAMEJ, STS$V_FAC_NO;, BYTE] NEQ FORSK_FAC_NO 

> 586 0647 2 THEN | 

s Ser 0648 § RETURN SS$_RESIGNAL; | 

; 588 0649 SIG_PC_LOC = STG_ARGS_ADR CCHFSL_SIG_ARG1] + (.SIG_ARGS_ADR CCHFS$L_SIG_ARG1] * %UPVAL); 

; «589 0650 2 IF [SIG_PC_LOC (OJ NEG O 

: 590 0651 THEN 

; #591 $636 RETURN SS$_RESIGNAL; 

: 236 65 

; oF 0654 § '¢ a 

; 2% 0655 ! If this is an error, and ERR= was specified by the user, 

s we 0656 ! Unwind to the user with saved RO being the IOSTAT value. 

; 596 0657 te 

; 597 0658 

; 598 0659 IF_..ENB_ARGS_ADR CERR_EQL_ADR] NEQA 0 | 

; oy 660 THEN 

; 600 

5 4 
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; 604 0665 HEN 
; 605 0666 RETURN SS$_NORMAL 
: 606 66 
; 607 0668 FORSSSIG_FATINT (); 
; 608 0669 
: 609 0670 END; 
; 610 0671 
3; 611 0673 \+ 
3 ol¢ 067 ! If ERR= not specified by the user 
; 61 0674 ! scan back from frame of establisher to frame of routine to called by user. 
> 614 0675 ' Set user CALL PC to Library in SIGNAL ary list. 
; 615 0676 ! Just indicate to the condition handling facility to resignal the condition 
: 61g peek so that a user supplied handler or the OTS default handler will get a chance to handle. 
; 618 0679 3 | 
3; 619 0680 EST_FP = .MCH_ARGS_ADR CCHFSL_MCH_FRAME]; 
; 620 0681 2 SIG-PC_LOC COJ = .EST_FP CSFSC_SAVE_PC); 
; Ge ee 2 RETORN SS$_RESIGNAL 
; 622 0683 1 END; !End of FORSSIOSTAT_HND | 
} 
000c 00000 .ENTRY FORSSIOSTAT_HND, Save R2,R3 3 0551) 
52 04 AC DO 00002 MOVL § SIG_ARGS_ADR, R2 ; 0633 | 
00000124 8F 06 A2 19 03 ED 00006 CMPZ2V #3, #25, -4(RO), #292 ; 
OE 12 00010 BNEQ 1 : 
50 OC AC DO 00012 MOVL  ENB_ARGS_ADR, RO : 0636 | 
04 BO DD 00016 PUSHL  @4(RO) : 
0000v CF 01 FB 00019 CALLS #1, CLEANUP_LUB : 
35 11 OOO1E BRB 2$ 3 0637 
18 06 A2 0c 00 ED 90020 1$: CMPZV #0, #12, 6(R2), #24 : 0646 
44 12 00026 BNEQ 5$ ; 
50 08 A2 DO 00028 OVL 8(R2), RO 3 0649 
53 08 A240 DE 990¢¢ MOVAL 8(R2)ERO], SIG_PC_LOC ; 
63 D5 00031 TSTL ($IG_PC_LOC) ; 0650 
37 12 00033 BNEQ 5$ : 
50 0c AC 00 00035 MOVL ENB_ARGS_ADR, RO : 0659 | 
08 860 re eit TSTL a8 (RO) § 
22 13 0003C BEQL = 4$ : | 
50 08 AC d0 0003 MOVL WCH_ARGS_ADR RO 3 0662 | 
oc ad 04 A2 0c Q3 EF 0004 EXTZV #3, -#12,~4(R2), 12(RO) : | 
43 C 9904 CLRQ = = §P) > 0664 | 
000000006 00 02 FB 0004 CALLS 4% SYSSUNWIND : 
04 50 €9 0005 BLBC . 3$ : 
50 01 DO 00055 2$: MOVL #1, RO 3; 0666. 
04 00058 RET 3 
000000006 00 00 FB 90039 3$: CALLS #0, FORSSSIG_FATINT > 0668 | 
50 08 AC DO 00060 4$: MOVL MCH_ARGS_ADR> RO 3 0460 | 
50 04 Ad D0 0064 MOVL 4(RO), EST_FP : | 
63 10 Ad D0 00068 MOVL \gcest FP); (S1G_PC_LOC) : 9681 
50 0918 8F 3C 906¢ 5$ MOVZWL #2328,7RO > 0682 | 
4 00071 RET 3 068 


; Routine Size: 114 bytes, Routine Base: _FORSCODE + 0168 


6 
Internal FORTRAN error handling module 16 e 
e 


WW 


oOo 
FAPASSASAPSAOAOAAS rw 
WAG Nm 
DONOAUVUVFSWAN-"OOONOu 


AAAAAAOAOS 
A 
ONOUSWN—O 


“1 
p= 1984 
GLOBAL ROUTINE FORSSIO_IN_PROG ( 

S1G_ARGS_ADR 
MCH~ARGS_ADRS 


1/0 in progress handler 

! Address of signal arg list 
Address of mechanism arg List 

= 


'e¢ 


FUNCTIONAL DESCRIPTION: 


FORSSIO_IN PROG is a special handler that is designed to 

allow the Run-Time Library to clean 1/0 that is in progress 
when an error occurs during the processing of a multi-call 

1/0 statement. For example, if evaluation of a variable 

List item in_a WRITE statement causes an error to be signalled, 
there is no RTL handler in the stack frame to catch the error 
and clean up in the case of an unwinc 


! 

i 

i 

i 

i 

i 

i 

i 

' This handler is enabled at the user's stack frame level. The 

: address of whatever user handler that was in the frame is stored 

‘ in the ISB. When an error is signallec, this handler finds 

: the address of the user handler, if any, and calls it. There 

: should be no normally detectable difference caused by FORS$$I0_IN_PROG 
: being on the frame. On unwind, the current ISB is popped and the 

: user's handler is called again. This way, we are protected against 
all errors on all call levels. 

FORMAL PARAMETERS: 

SIG_ARGS_ADR.ml.ra Address of signal arguments List. 
MCH_ARGS_ADR.ml.ra Address of mechanism arguments List 

IMPLICIT INPUTS: 

1SB/LUB/RAB database 

IMPLICIT OUTPUTS: 

; 1SB/LUB/RAB database 

; COMPLETION CODES: 

i 
le 


Whatever is returned by the user handler. 


BEGIN 


GLOBAL REGISTER 
CCB = 11 : REF SFORSCCB_DECL; 


BUILTIN 
CALLG, 

LOCAL 
USER_HANDLER, ! Address of user's handler 
EST_FP : REF BLOCK C, BYTE); ! Establisher's FP 


MAP 


Be 92:89:54 EPGaRTLoSReSFORENROR.039; 1 
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1-022 14-Sep-1984 12:31:54 FORRTL.SRCJFORERROR.B32; 1 (6) 
; 68 4g SIG_ARGS_ADR : REF BLOCK fF. BYTE: ' signal argument List ; 
: re ti St MCH_ARGS_ADR : REF BLOCK [, BYTEJ; ! mechanism argument List ‘ 
: 685 0745 rr ; 
; 686 res ' Get establisher's FP . 
: 687 74 !< : 
; 688 748 : 
; 689 0749 EST_FP = .MCH_ARGS_ADR CCHFSL_MCH_FRAME); ‘ 
; 690 Bree : 
; 691 0751 ‘+ : 
; oF O76 ! See if we are unwinding. ; 
: 83 O78 e 
: 695 0755 IF .BLOCK CSIG_ARGS_ADR CCHFSL_SIG_NAME], STS$V_COND_ID;, BYTE] EQL (SS$_UNWIND*=3) ‘ 
; 696 0756 THEN : 
; 697 0757 BEGIN : 
s 243 O78 FORSSCB_GET (); ! Get address of current LUB ‘ 
; £00 0760 IF .EST_FP NEQ .CCB CISBSA_USER_FP] THEN FORSSSIG_FATINT (); ' Error : 
: 702 Or6e 3 USER HANDLER = .CCB CISB$A_USR_HANDLJ; ! Get user's handler address : 
: at the ; CLEANUP_LUB (FORSK_UNWINDPOP) ; ! Clean up LUB and restore user's handler : 
: 05 0765 3 IF .USER_HANDLER NEQ 0 THEN RETURN CALLG (.AP, .USER_HANDLER); | ; 
: 707 0767 : RETURN SS$_NORMAL; | : 
: 708 0768 END; ‘ 
: 709 0769 ; 
: 710 0770 1+ : 
s 7ii 0771 § ! This is a signal. Find the ISB that matched the establisher's : 
: 7le2 0778 i FP, : 
: 713 077 g in ; 
: 714 0774 | : 
; 715 0775 é FORSSFP_MATCH (.EST_FP); : 
; 716 0776 3 
ah 0777 2 '¢ : 
; 718 0778 2 ' Call user's handler and return. ; 
3 719 0779 2 in ; 
; 720 0780 2 : 
; ze 0781 3 USER_HANDLER = .CCB CISBSA_USR_HANDL]; : 
: 738 Ores é IF .USER_HANDLER NEQ 0 THEN RETURN CALLG (.AP, .USER_HANDLER) ELSE RETURN SS$_RESIGNAL; : 
; 725 0785 1 END; ! End of FORS$IO_IN_PROG : 
080¢ 900 ENTRY FORSSIO_IN PROG, Save R2,R3,R11 : 0685. : 
50 8 ac 00 00 MOVL §§MCH_ARGS_ADBR, RO : 0749 ; 
4 ad 00 00 MOVL 4(RO), EST_FP ; ; 
50 4 ac 0 A MOVL 16_ARGS_AR RO ; 0755. : 
00000124 8F 04 a0 19 i2 Of CMPZY 83, #25, 4(RO), #292 ; | : 
000000006 1 1A JSB ss FORSSCB_GET : 0758 3 
FF4C CB D1 00020 CMPL EST PP 1 80(CCB) ; 0760 ; 
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: f 3 788 ! ROUTINE CLEANUP_LUB (ACTION) : NOVALUE = 
: 730 07 § 1 !44 

; f 1 oy i FUNCTIONAL DESCRIPTION: 

: 4 5 O78 ; Perform the UNWIND action indicated by ACTION on the current LUB. 

: 735 0794 1 | FORMAL PARAMETERS: | 
; 736 8582 1! 

; ay P38 i ACTION. rlu.v FORSK_UNWINDNOP, FORSK_UNWINDPOP, or FORSK_UNWINDRET. 
: t35 O88 1 i-- | 
; 740 799 «1 

3 oe ban} : BEGIN 

: 0g 080¢ GLOBAL REGISTER | 
: ee Bapz 2 CCB = 11 : REF SFORSCCB_DECL; 
: 746 0805 ‘ BIND 
; a? 0806 ; FAB = CCB: REF SFORSFAB_CCB_STRUCT; | 
: 749 0808 CASE .ACTION FROM FORSK_UNWINDPOP TO FORSK_UNWINDRET OF | 
cae Btls 
; 138 0811 2 1+ 

; orig 2 ! If the UNWIND action is to pop the LUB/ISB/RAB, call CB_POP to do 

3; 754 081 2 ' the work. 

: Fe ee : | 
: 757 0816 é CFORSK_UNWINDPOP : | 
: Fe OB18 3 7 | 
: 760 0819 3 LOCAL | 
3 ee +t] ; USER_FP; ' User's FP 
: 76 0822 3 FORSSCB_GET (); ' CCB set to adr. of current /LUB/ISB/RAB 

s res 34 3 USER_FP = .CCB CISBSA_USER_FP); ' Get user's FP 
: oe tH ; IF .USER_FP NEQ 0 THEN .USER_FP = .CCB CISBSA_USR_HANDLJ; ' Restore user's handler | 
: 768 0827 3 CCB CRABSL_UBF] = .CCB CLUBSA_RBUF_ADR): | 
> 769 0828 3 CCB CRABSW-USZ) = .CCB CLUB$W~RBUF~SIZE); | 
; 770 +134 3 FORS$CB_POP (); 
3 4g bags END; 

: 77 0832 re 

3; 774 83 ' If the UNWIND action is NOP, do nothing. 

: 775 0834 2 !- 

; 776 0835 

3 ee ty: CFORSK_UNWINDNOP) : 

: 779 0838 ’ 

; 780 0839 '¢ 

3; «(781 0840 ! If the UNWIND action is RET, then try to SCLOSE the file associated 

s 7 0841 i with this LUB/ISB/RAB. Deallocate an dynamic storage associated 

3 SS Oac$ ! with this LUB. Return the LUB/ISB/RAB to free storage. 
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1-022 ° 12-8 08- 1 3be 00:99 :3) FORRTL. SRCIFORERROR.B3 31 
> 785 B44 CFORSK_UNWINDRET]) : 
: res Ose PORSSCB GET () ' Set CCB d f UB/1SB/RAB 
; e : : Set to adr. of current L 
: 788 thd '+ 
; 789 0848 ' See if file is RMS opened. 
: 790 0849 t= 
: 99) Seay IF (.FAB CFABSW_IFIJ NEQ 0) 
; th THEN = 
: 794 085 + 
; 795 0854 ! Do an RMS Close of the file, and arrange to deallocate its LUB/ISB/RAB 
: 79 Bees ! when all 1/0 to it is finished. Normally, we are doing the only 1/0 
; 79 856 ' to it. 
; 798 0857 '- 
; 799 0858 FORSSCLOSE_FILE () 
: 800 0859 LSE 
; 801 0860 '+ 
; 80 0861 ' Even Fhough the file is not open, we wish to deallocate the LUB, since 
; 80 pees ' this is the simplest way to reinitialize it if the user tries to use 
3 Boe Sati ; } the logical unit number again, so tell OTS$$POP_CCB to deallocate it. 
; 806 0865 ; CCB CLUBSV_DEALLOC) = 1; 
: 807 0866 
; 808 0867 3 !+ 
; 809 0868 3 ! We are done with the logical unit. 
: 810 0869 3 !- 
> «6811 0870 3 FORSS$CB_POP (); 
: 812 0871 2 END; 
: 813 oBrg 2 TES; 
3: «B14 0873 2 
; «6815 0874 1 END; 
0804 00000 CLEANUP_LUB: 
-WORD Save R2,R11 
52 00000000G 00 9€ 00002 MOVAB FORSSCB_GET, R2 
02 0 04 A CF 00009 CASEL ACTION, #0, #2 
0020 003A 0006 QOOOE 1$: «WORD + at Se 
4$-1$ 
62 16 00014 2$: JSB FORSS$CB_GE 
50 FF4C CB DO 00016 MOVL -180(CCB), USER_FP 
05 13 00018 BEQL 3$ 
60 FF44 CB dO 0001 MOVL -188(CCB), (USER_FP) 
24 AB EC AB DO 000 3$: MOVL -20(CCB), 35 ¢ccey 
20 «(AB D2 AB 99 0 MOV ~46(CCB), 32(CCB) 
14 1 C BRB 6$ 
62 1 4$: JSB FORS$CB_GET 
46 AB B BS TSTW 70(F AB) 
09 1 0 BEQL 5$ 
00000000G 00 80 4 8 CALLS #0, FORSSCLOSE_FILE 
4 1 C BRB 6$ 
AB 10 88 000 3 5$: BISB2 #16, -1(FAB) 
000000006 00 16 00042 é$: JSB FOR$$CB_POP 


ro 


851. 
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1-022 . 1er8ep- 198 19:89:54 LRORRTL SRETFORERROR 03951 a 
04 00048 7$: RET ; 0874 
; Routine Size: 73 bytes, Routine Base: _FORSCODE + 0236 
: BIg O87 1 END End of modul 
; 'En e 
: BIB 0877 1 soi ses 
; «4819 0878 0 ELUDOM 
; PSECT SUMMARY 
; Name Bytes Attributes 
:  _FORSCGDE 639 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) | 
| 
; Library Statistics ; 
a Beds ee ae, re ee Symbols -------=- Pages Processing . 
: File Total Loaded Percent Mapped Time | ‘ 
: _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 18 0 581 00:01.0 | ; 
3 ~$255$DUA28: CFORRTL.OBJIJFORLIB.L32;1 714 190 26 52 00:00.6 
3 ~$255$DUA28:CFORRTL.OBJIRTLLIB.L32;1 36 0 0 8 00:00.1 
| 
| 
: COMMAND QUALIFIERS | 
3 BLISS/CHECK=(FIELD, INITIAL, OPTIMIZE) /NOTRACE/LIS=LIS$:FORERROR/OBJ=OBJ$:FORERROR MSRC$:FORERROR/UPDATE=(ENHS$: fF ORERROR) 
; Size: 639 cede + 0 data bytes 
Run Time: 16.9 
Elapsed Time: 00:45.4 


Lines/CPU Min: HS! 
Lexemes/CPU-Min: 15828 
poe | Used: 119 pages 
Compi ation Complete 
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